home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 301_400 / DISK0324 / DISK0324.ZIP / TENKEY.PAS < prev    next >
Pascal/Delphi Source File  |  1984-07-10  |  3KB  |  120 lines
  1. PROGRAM TenKey;
  2.  
  3. {  This program emulates a dedicated '10 key' calculator.  It allows  }
  4. {  you to add, subtract, divide, and multiply.  The program operates  }
  5. {  like a TI calculator; you must type a number, then operation,      }
  6. {  another number and the SPACE or EQUALS keys to get the result.     }
  7.  
  8. {                       123   +                                       }
  9. {                         1   =                                       }
  10. {                       124  ANSWER                                   }
  11.  
  12. {  Written for Turbo Pascal by Jeff Firestone. June 1984.             }
  13.  
  14. CONST
  15.   BS = #8;
  16.   CR = #13;
  17.  
  18. VAR
  19.   StackPtr, code, i, j : INTEGER;
  20.   edit : STRING[20];
  21.   value, oldvalue : REAL;
  22.   Key, Operator : CHAR;
  23.  
  24. {-------------------------------------------------------------}
  25.  
  26. PROCEDURE Initialize;
  27. BEGIN
  28.   GOTOXY(25,15); WRITE('TEN KEY CALCULATOR PROGRAM');
  29.   GOTOXY(20,17); WRITE('Type the numbers first followed by +,-,/,*');
  30.   GOTOXY(30,18); WRITE('Use ESC to exit.');
  31.   value:= 0; oldvalue:= 0;
  32.   Edit:= ''; Operator:= ' ';
  33.   GOTOXY(1, 25); WRITE('0':14); CLREOL;
  34. END;
  35.  
  36. {-------------------------------------------------------------}
  37.  
  38. PROCEDURE PrintValue;
  39. BEGIN
  40.   GOTOXY(1, 25); WRITELN;
  41.   GOTOXY(1, 24);
  42.   WRITE(value:20:5);
  43.   IF Key IN ['+','-','*','/','='] THEN
  44.     WRITELN('   ', Key)
  45.   ELSE
  46.     IF Key = 'A' THEN WRITELN('  ANSWER');
  47.   edit:= '';
  48. END;
  49.  
  50. {-------------------------------------------------------------}
  51.  
  52. PROCEDURE DoMath;
  53. BEGIN
  54.   oldvalue:= value;
  55.   VAL(edit, value, code);
  56.   PrintValue;
  57.   CASE Operator OF
  58.     '+' : value:= oldvalue + value;
  59.     '-' : value:= oldvalue - value;
  60.     '*' : value:= oldvalue * value;
  61.     '/' : IF value <> 0 THEN value:= oldvalue / value;
  62.   END;
  63. END;
  64.  
  65. {-------------------------------------------------------------}
  66.  
  67. PROCEDURE BackSpace;
  68. BEGIN
  69.   IF (LENGTH(edit) > 0) THEN
  70.     edit:= COPY(edit, 1, (LENGTH(edit)-1));
  71. END;
  72.  
  73. {-------------------------------------------------------------}
  74.  
  75. PROCEDURE Equals;
  76. BEGIN
  77.   Key:= '=';
  78.   DoMath;
  79.   Key:= 'A';
  80.   PrintValue;
  81.   value:= 0; oldvalue:= 0; Operator:=' ';
  82.   WRITELN; WRITELN;
  83. END;
  84.  
  85. {-------------------------------------------------------------}
  86.  
  87. PROCEDURE MathFunc;
  88. BEGIN
  89.   DoMath;
  90.   Operator:= Key;
  91. END;
  92.  
  93. {-------------------------------------------------------------}
  94.  
  95. BEGIN
  96.   Initialize;
  97.   REPEAT
  98.     GOTOXY(14, 25);
  99.     READ(KBD, Key);
  100.     CASE Key OF
  101.       '+' : MathFunc;
  102.       '-' : MathFunc;
  103.       '/' : MathFunc;
  104.       '*' : MathFunc;
  105.       BS  : BackSpace;
  106.       '=' : Equals;
  107.       ' ' : Equals;
  108.     ELSE
  109.       IF (Key IN ['0'..'9','.']) AND ((LENGTH(edit) < 10)) THEN
  110.         Edit := Edit + key;
  111.     END;
  112.     GOTOXY(1,25);
  113.     IF edit = '' THEN
  114.       WRITE('0':14)
  115.     ELSE
  116.       WRITE(edit:14);
  117.     CLREOL;
  118.   UNTIL Key = #27;
  119. END.
  120.